home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / COLOR.SWG / 0012_Palette Control.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  7KB  |  207 lines
  1. {
  2.  Hello, could somone tell me how to fade a screen out..
  3. }
  4.  
  5. { --------------------------------------------------------------------- }
  6. { Palette Unit (Text and Graphics modes)                                }
  7. { Author: Geoff Watts, 27-07-92                                         }
  8. { Usable Procedures:                                                    }
  9. {   fadeup    -- fade the palette up                                    }
  10. {   fadedown  -- fade the palette down                                  }
  11. {   getpal256 -- fill the parameter Pal With the palette values         }
  12. {   setpal256 -- fill the palette values With the parameter Pal         }
  13. {   cpuType   -- determines wether the cpu is 8086/88 or different      }
  14. { --------------------------------------------------------------------- }
  15.  
  16. Unit Palette;
  17. Interface
  18. Uses Dos;
  19. { structure in which the palette inFormation is stored }
  20. Type
  21.   PaletteType = Array[0..255,1..3] of Byte; { 256 Red/Green/Blue (RGB)    }
  22. Var
  23.   OlPlt  : PaletteType;                     { internal palette structure  }
  24.                                             { which contains the standard }
  25.                                             { palette                     }
  26.   SetPal256: Procedure (Var Pal : PaletteType); { the Procedure determined    }
  27.                                                 { at run time                 }
  28. { Forward declarations }
  29. Procedure SetPal86 (Var Pal : PaletteType);
  30. Procedure SetPal286 (Var Pal : PaletteType);
  31. Procedure FadeUp;
  32. Procedure FadeDown;
  33. Function  CpuType : Boolean;
  34. Implementation
  35. {
  36.     GetPal256:
  37.         Load Pal Structure With the 256 RGB palette
  38.         values.
  39. }
  40. Procedure GetPal256 (Var Pal : PaletteType);
  41. Var
  42.   loope : Word;
  43. begin
  44.   port[$3C7] := 0;
  45.   { when a read is made on port $3C9 it increment port $3C7 so no changing }
  46.   { of the register port ($3C7) needs to be perFormed here                 }
  47.   For loope := 0 to 255 do
  48.     begin
  49.       Pal[loope,1] := port[$3C9];   { Read red value   }
  50.       Pal[loope,2] := port[$3C9];   { Read green value }
  51.       Pal[loope,3] := port[$3C9];   { Read blue value  }
  52.     end;
  53. end;
  54. {
  55.     SetPal86:
  56.         Loads the palette Registers With the values in
  57.         Pal.
  58.     86/88 instructions.
  59. }
  60. Procedure SetPal86 (Var Pal : PaletteType);
  61. begin
  62.   Asm
  63.     push    ds      { preserve segment Registers }
  64.     push    es
  65.     mov cx,256 * 3  { 256 RBG values             }
  66.     mov dx,03DAh
  67.     { by waiting For the retrace to end it avoids static }
  68.     { when the palette is altered                        }
  69. @retrace1:
  70.     in  al,dx       { wait For no retrace        }
  71.     and al,8        { check For retrace          }
  72.     jnz @retrace1   { so loop Until it goes low  }
  73. @retrace2:
  74.     in  al,dx       { wait For retrace           }
  75.     and al,8        { check For retrace          }
  76.     jz  @retrace2   { so loop Until it goes high }
  77.     lds si, Pal     { ds:si = @Pal               }
  78.     mov dx,3c8h     { set up For a blitz-white   }
  79.     mov al,0        { from this register         }
  80.     cli             { disable interrupts         }
  81.     out dx,al       { starting register          }
  82.     inc dx          { set up to update DAC       }
  83.     cld             { clear direction flag       }
  84. @outnext:
  85.     { the following code is what I have found to be the  }
  86.     { most efficient way to emulate the "rep outsb"      }
  87.     { instructions on the 8086/88                       }
  88.     lodsb               { load al With ds:[si]       }
  89.     out dx,al           { out al to port in dx       }
  90.     loop    @outnext    { loop cx times              }
  91.     sti                 { end of critical section    }
  92.     pop es
  93.     pop ds              { restore segment Registers  }
  94.   end;
  95. end;
  96. {$G+}       { turn on 286 instruction generation }
  97.  
  98. { --------------------------------------------------------------------- }
  99. { Palette Unit (Text and Graphics modes)                                }
  100. { --------------------------------------------------------------------- }
  101. {
  102.     SetPal286:
  103.         Loads the palette Registers With the values in
  104.         Pal.
  105.     286+ instructions.
  106. }
  107. Procedure SetPal286 (Var Pal : PaletteType);
  108. begin
  109.   Asm
  110.     push    ds      { preserve segment Registers }
  111.     push    es
  112.     mov cx,256 * 3  { 256 RBG values             }
  113.     mov dx,03dah
  114.     { by waiting For the retrace to end it avoids static }
  115.     { when the palette is altered                        }
  116. @retrace1:
  117.     in  al,dx       { wait For no retrace        }
  118.     and al,8        { check For retrace          }
  119.     jnz @retrace1   { so loop Until it goes low  }
  120. @retrace2:
  121.     in  al,dx       { wait For retrace           }
  122.     and al,8        { check For retrace          }
  123.     jz  @retrace2   { so loop Until it goes high }
  124.     lds si, Pal     { ds:si = @Pal               }
  125.     mov dx,3c8h     { set up For a blitz-white   }
  126.     mov al,0        { from this register         }
  127.     cli             { disable interrupts         }
  128.     out dx,al       { starting register          }
  129.     inc dx          { set up to update DAC       }
  130.     cld             { clear direction flag       }
  131.     rep outsb       { 768 multiple out's         }
  132.                     { rapid update acheived      }
  133.     sti             { end of critical section    }
  134.     pop es
  135.     pop ds          { restore segment Registers  }
  136.   end; { Asm }
  137. end; { SetPal286 }
  138. {$G-}               { turn off 286 instructions }
  139. {
  140.     fadedown:
  141.         fades the palette down With little or no static
  142. }
  143. Procedure fadedown;
  144. Var
  145.   Plt     : PaletteType;
  146.   i, j, k : Integer;
  147. begin
  148.   plt := olplt;
  149.   For k := 0 to 63 do
  150.     begin
  151.       For j := 0 to 255 do
  152.     For i := 1 to 3 do
  153.           if Plt[j,i] <> 0 then
  154.             dec(Plt[j,i]);      { decrease palette numbers gradually }
  155.       SetPal256(Plt);           { gradually fade down the palette    }
  156.     end;
  157. end;
  158. {
  159.     fadeup:
  160.         fades the palette up With little or no static
  161. }
  162. Procedure fadeup;
  163. Var
  164.   Plt     : PaletteType;
  165.   i, j, k : Integer;
  166. begin
  167.   GetPal256(Plt);           { Load current palette }
  168.   For k := 1 to 63 do
  169.     begin
  170.       For j := 0 to 255 do
  171.         For i := 1 to 3 do
  172.           if Plt[j,i] <> OlPlt[j,i] then
  173.             inc(Plt[j,i]);      { bring palette back to the norm }
  174.         SetPal256(Plt);         { gradually fades up the palette }
  175.                                 { to the normal values           }
  176.     end;
  177. end;
  178. {
  179.     CpuType:
  180.         determines cpu Type so that we can use 286 instructions
  181. }
  182. Function CpuType : Boolean;
  183. Var cpu : Byte;
  184. begin
  185.   Asm
  186.     push sp
  187.     pop  ax
  188.     cmp  sp,ax                  { stack Pointer treated differently on }
  189.     je   @cpu8086               { the 8086 Compared to all others      }
  190.     mov  cpu,0
  191.     jmp  @cpufound
  192. @cpu8086:
  193.     mov cpu,1
  194. @cpufound:
  195.   end; { Asm }
  196.   cpuType := (cpu = 1);
  197. end;
  198. begin
  199.   { determine the cpu Type so that we can use faster routines }
  200.   if CpuType then
  201.     SetPal256 := SetPal286
  202.   else
  203.     SetPal256 := SetPal86;
  204.   { load the standard palette }
  205.   GetPal256(OlPlt);
  206. end.
  207.